VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsUpdateInterface"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Public Function Update_Interface(sData As String) As Boolean
    Dim Com_Id
    Dim Bu_Id
    Dim Message_Id
    Dim Created_date
    Dim mq_status
    Dim DTD_String
    Dim StartInd
    Dim EndInd
    Dim LoopStart
    Dim Tempstring As String
    Dim sSQL As String
    Dim FKXml
    Dim UpdateSQL As Boolean
    Dim rsKey As ADODB.Recordset
    Dim xmldoc As MSXML2.DOMDocument
    Dim nNodeList As MSXML2.IXMLDOMNodeList
    Dim nChildren As MSXML2.IXMLDOMNodeList
    Dim eElement As MSXML2.IXMLDOMElement
    
    StartInd = sData
    
    DTD_String = Left(sData, InStr(1, sData, "<KeyTax") - 1)
    sData = Mid(sData, InStr(1, sData, "<KeyTax"))
    
    Set xmldoc = New MSXML2.DOMDocument
    xmldoc.loadXML (sData)
    sData = DTD_String
    sData = sData & xmldoc.xml
    
    Set nNodeList = xmldoc.getElementsByTagName("Tracking")
    If nNodeList.length > 0 Then
        Set nChildren = nNodeList.Item(0).childNodes
        Set eElement = nChildren.Item(0)
        Do While Not (eElement Is Nothing)
            Select Case eElement.nodeName
                Case "Company"
                    Com_Id = Trim(eElement.getAttribute("ID"))
                Case "BusinessUnit"
                    Bu_Id = Trim(eElement.getAttribute("ID"))
                Case "Message"
                    Message_Id = Trim(eElement.getAttribute("ID"))
            End Select
            Set eElement = nChildren.nextNode
        Loop
    End If
    
    xmldoc.Save "C:\Mindkey\Keytax\Error\ErrorReceived\" & Message_Id & ".xml"
    
    
    Set xmldoc = Nothing
    Set eleement = Nothing
    Set nNodeList = Nothing
    
'Setup Created_date
    Created_date = Now
    
    
'Setup mq_status
    mq_status = "01"
    'frmSplash.lMsg.Caption = "Message received " & Counter
    sSQL = "Insert into "
    sSQL = sSQL & "dir_interface_index (com_id , bu_id , message_id , mq_status,created_date) "
    sSQL = sSQL & "values ('" & Com_Id & "','" & Bu_Id & "','" & Message_Id & "','" & mq_status & "','" & Format(Created_date, "YYYY/MM/DD HH:M:ss") & "')"
    'sSQL = "select * from dir_interface_index"
    
    UpdateSQL = Update_SQL(sSQL, "KeyTaxSQL")
    If UpdateSQL = True Then
        sSQL = " select * from dir_interface_index where message_id = '" & Message_Id & "' and created_date = '" & Format(Created_date, "YYYY/MM/DD HH:M:ss") & "'"
    
        Set rsKey = Get_Recordset(sSQL, "KeyTaxSQL")
        FKXml = rsKey("interface_no").Value
        'MsgBox rsKey.RecordCount
        Set rsKey = Nothing
        
        'AP fix o'riely problem
        'replace any ' with ''
        sData = Replace(sData, "'", "''")
        'end of AP change
        
        'build the insert stmnt
        sSQL = " insert into dir_interface_xml (interface_no, xml_string, message_id ) "
        sSQL = sSQL & " values( '" & FKXml & "','" & CStr(sData) & "','" & Message_Id & "')"
    
        UpdateSQL = Update_SQL(sSQL, "KeyTaxSQL")
        If UpdateSQL = False Then
            sSQL = " delete dir_interface_index where message_id = '" & Message_Id & "' and created_date = '" & Format(Created_date, "YYYY/MM/DD HH:M:ss") & "'"
            UpdateSQL = Update_SQL(sSQL, "KeyTaxSQL")
        End If
    Else
        If Not xmldoc Is Nothing Then
            xmldoc.Save "C:\Mindkey\Keytax\Error\In Progress\" & Message_Id & ".xml"
        Else
            MsgBox ("Could not update interface index. An error occurred: " & Err.Description)
        End If
    End If
    
    

End Function

